home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / graphic / rcdsplay.zip / IOFUNCS.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-18  |  25KB  |  632 lines
  1. {**********************************************************************
  2.  Unit   : IOFUNCS
  3.  Version: 1.8
  4.  Purpose: This unit contains useful procedures to simplify IO tasks.
  5.  Author : Translated form those of Mike Riebe (MISFUNCS, version 3.3)
  6.           by Roger Carlson.
  7.  Changes: 5/17/90 (RJC,1.1) - Added the procedures of version 1.7 of
  8.             RCGRAF.
  9.           5/31/90 (RJC,1,2) - Removed the RLTOSTR, DBLTOSTR, LNGTOSTR,
  10.             and INTTOSTR procedures which are more easily implemented
  11.             by Turbo Pascal's STR procedure.
  12.           6/9/90 (RJC,1.3) - Added graphics mode rdstr procedures and
  13.             INTTOSTR.
  14.           2/15/91 (RJC,1.4) - Added line feed at end of some procedures.
  15.           3/28/91 (RJC,1.5) - Added RLTOSTR funciton and the graphics
  16.             mode GRDINT procedure.
  17.           5/3/91 (RJC,1.6) - Added graphics mode GRDDBL and GRDREAL
  18.             procedures.
  19.           5/11/91 (RJC,1.7) - Added the DOS shell command DOS_CMD.
  20.           5/18/91 (RJC,1.8) - Added LNGTOSTR function and RDLONGLN
  21.             procedure.
  22. ***********************************************************************}
  23. UNIT IOFUNCS;
  24.  
  25. INTERFACE
  26.  
  27. TYPE STR160 = STRING[160];  STR80  = STRING[80];  STR40  = STRING[40];
  28.      STR30  = STRING[30];   STR20  = STRING[20];  STR3   = STRING[3];
  29.  
  30. PROCEDURE rdrealn(VAR window : TEXT; VAR value : REAL);
  31. PROCEDURE rddbln(VAR window : TEXT; VAR value : DOUBLE);
  32. PROCEDURE rdintln(VAR window : TEXT; VAR value : INTEGER);
  33. PROCEDURE RDLONGLN(VAR WINDOW:TEXT; VAR VALUE:LONGINT);
  34. PROCEDURE rdstr160(VAR window : TEXT; VAR value : STR160);
  35. PROCEDURE rdstr80(VAR WINDOW:TEXT; VAR value:STR80);
  36. PROCEDURE rdstr40(VAR WINDOW:TEXT; VAR value:STR40);
  37. PROCEDURE rdstr30(VAR WINDOW:TEXT; VAR value:STR30);
  38. PROCEDURE rdstr20(VAR window : TEXT; VAR value : STR20);
  39. PROCEDURE rdstr3(VAR window : TEXT; VAR value : STR3);
  40. PROCEDURE rdcharln(VAR window : TEXT; VAR value : CHAR);
  41. PROCEDURE GRDSTR160(VAR VALUE:STR160);
  42. PROCEDURE GRDSTR80(VAR VALUE:STR80);
  43. PROCEDURE GRDSTR40(VAR VALUE:STR40);
  44. PROCEDURE GRDSTR30(VAR VALUE:STR30);
  45. PROCEDURE GRDSTR20(VAR VALUE:STR20);
  46. PROCEDURE GRDSTR3(VAR VALUE:STR3);
  47. PROCEDURE GRDCHAR(VAR VALUE:CHAR);
  48. PROCEDURE GRDINT(VAR VALUE:INTEGER);
  49. PROCEDURE GRDDBL(VAR VALUE:DOUBLE);
  50. PROCEDURE GRDREAL(VAR VALUE:REAL);
  51. FUNCTION CALCINCR(INCR:DOUBLE):DOUBLE;
  52.     {This function returns the largest power of 1, 2, or 5 <= INCR and can be
  53.      used to calculate round number intervals for labeling of plots.  INCR
  54.      should be a positive number.}
  55. PROCEDURE ENGNOT(NUMBER:DOUBLE; VAR MANTISSA:DOUBLE; VAR EXPONENT:LONGINT);
  56.     {This procedure calculates the engineering notation mantissa and exponent
  57.      for the number NUMBER.}
  58. FUNCTION NUMDEC(NUM:DOUBLE):INTEGER;
  59.     {Calculates the number of decimals in a number to an accuracy of about 1
  60.      part in 1E6}
  61. FUNCTION EXISTS(FILENAME:STR30):BOOLEAN;
  62. PROCEDURE BEEP(HZ:WORD);
  63. FUNCTION INTTOSTR(I:INTEGER):STR80; {Converts an integer to a string.}
  64. FUNCTION LNGTOSTR(I:LONGINT):STR80; {Converts a long integer to a string.}
  65. FUNCTION RLTOSTR(RL:REAL;WIDTH:INTEGER):STR80;
  66.   {Converts a real number to a string.}
  67. PROCEDURE DOS_CMD; {executes a dos command}
  68.  
  69.  
  70. IMPLEMENTATION
  71.  
  72. USES CRT, GRAPH, DOS, MATH;
  73.  
  74. {************************ PROCEDURE DOS_CMD **************************}
  75. PROCEDURE DOS_CMD;
  76. VAR NAME:STR80;
  77. BEGIN
  78.   CLRSCR;
  79.   WRITE('Command: '); RDSTR80(OUTPUT,NAME); WRITELN;
  80.   SWAPVECTORS; EXEC('C:\COMMAND.COM',CONCAT('/C ',NAME)); SWAPVECTORS;
  81.   IF DOSERROR<>0 THEN WRITELN('DOS ERROR # ',DOSERROR);
  82.   WRITE('Hit <ENTER> to continue.'); READLN;
  83. END;
  84.  
  85. {******************************************************************************
  86.   TITLE:    RDREALN(VAR WINDOW:TEXT; VAR VALUE : REAL);
  87.   FUNCTION: To provide a mechanism for reading real numbers from the keyboard
  88.             as well as provide for keeping the current value of the variable
  89.             to be read by inputing a carriage return.
  90.   INPUTS:   A string of digits including '+','-','.',and 'E' defining a real
  91.             value.
  92.   OUTPUTS:  A new value for a variable unless <CR> was the only character
  93.             in the input string.
  94.   AUTHOR:   M. Riebe  11/17/84
  95.   CHANGES:  12/06/84:  Fixed procedure for finding starting index so that only
  96.                        digits are valid.
  97.             5/15/85 MTR: Fixed correction procedure to allow backspaces.
  98.             6/20/85 RJC: Improved error correction.
  99.             10/1/85 MTR: Changed to use RDDBLN and convert to real.
  100.             10/30/85 RJC:Fixed so that value unchanged if return is entered.
  101.             4/8/90   RJC:Translated to Turbo Pascal.
  102. ******************************************************************************}
  103. PROCEDURE RDREALN;
  104. VAR DBLTEMP:DOUBLE;
  105. BEGIN DBLTEMP:=VALUE; RDDBLN(WINDOW,DBLTEMP); VALUE:=DBLTEMP; END;
  106.  
  107. {******************************************************************************
  108.   TITLE:    RDDBLN(VAR WINDOW:TEXT; VAR VALUE:DOUBLE)
  109.   VERSION:  1.1
  110.   FUNCTION: Input of double precision real numbers interactively from the
  111.             keyboard.
  112.   AUTHOR:   RJC 9/29/85
  113.   CHANGES:  (4/8/90, 1.1, RJC) - Translated to Turbo Pascal.  Modified to
  114.                prevent reading of spurious characters and backspacing before
  115.                the first character.
  116. ******************************************************************************}
  117. PROCEDURE RDDBLN;
  118. VAR
  119.   CH                 : CHAR;
  120.   I,J,K,L,M,N,POWVAL : INTEGER;
  121.   ASCII              : ARRAY[1..20] OF INTEGER;
  122.   NEG,POWNEG         : BOOLEAN;
  123. BEGIN {1}
  124.   NEG := FALSE;  POWNEG := FALSE;  POWVAL := 0;  I := 1;
  125.   REPEAT
  126.     REPEAT CH:=READKEY
  127.     UNTIL CH IN ['0'..'9','+','-','D','E','.',CHR(13),CHR(8)];
  128.     ASCII[I]:=ORD(CH);
  129.     IF (ASCII[I] = 8) THEN BEGIN
  130.       IF I<>1 THEN WRITE(WINDOW,CH,' ',CH);
  131.       IF I<=2 THEN I:=0 ELSE I:=I-2;
  132.       END
  133.     ELSE WRITE(WINDOW,CH);
  134.     I:=I+1;
  135.   UNTIL ORD(CH)=13;
  136.   I:=I-1;                   {leave index at last character}
  137.   IF ASCII[1]<>13 THEN BEGIN {2}
  138.       VALUE:=0; J:=0; K:=0;
  139.       REPEAT J:=J+1 UNTIL ASCII[J] IN [43,45..58];
  140.       REPEAT K:=K+1 UNTIL ASCII[K] IN [46,68,69,13];
  141.       CASE ASCII[J] OF
  142.          43 {+}: J:=J+1;
  143.          45 {-}: BEGIN NEG:=TRUE; J:=J+1; END;
  144.       END; {CASE}
  145.       FOR L:=J TO (K-1) DO VALUE:=VALUE+(ASCII[L]-48)*PWROF10(K-L-1);
  146.       IF ASCII[K]=46 THEN BEGIN {'.'}
  147.         M := K;
  148.         REPEAT M:= M + 1 UNTIL ASCII[M] IN [68,69,13];
  149.         FOR N:=K+1 TO M-1 DO VALUE:=VALUE+(ASCII[N]-48)/PWROF10(N-K);
  150.         K := M;
  151.         END; {IF}
  152.       IF ASCII[K] IN [68,69] THEN BEGIN {'D' or 'E'}
  153.         CASE ASCII[K+1] OF
  154.           43 {+}: K:=K+1;
  155.           45 {-}: BEGIN POWNEG:=TRUE; K:=K+1; END;
  156.         END; {CASE}
  157.         FOR N:=K+1 TO I-1 DO POWVAL:=POWVAL+
  158.                              (ASCII[N]-48)*ROUND(PWROF10(I-N-1));
  159.         END; {IF}
  160.       IF NEG THEN VALUE:=VALUE*(-1);
  161.       IF POWNEG THEN VALUE := VALUE/PWROF10(POWVAL)
  162.       ELSE VALUE := VALUE*PWROF10(POWVAL);
  163.     END;  {2}
  164.   WRITE(WINDOW,CHR($0A)); {line feed}
  165.   END; {1}
  166.  
  167. {******************************************************************************
  168.   TITLE:     rdintln(VAR WINDOW:TEXT; VAR VALUE:INTEGER);
  169.   FUNCTION:  To provide a mechanism for reading integers from the keyboard
  170.              while providing for keeping the current value of the variable
  171.              if a carriage return is input.
  172.   INPUTS:    A string of digits followed by a <CR> or just a <CR>.
  173.   OUTPUTS:   A new value for the variable value unless <CR> was the only
  174.              character in the input string.
  175.   NOTES:     Should someday be modified to allow input from any file type,
  176.              i.e., not just INPUT.
  177.   AUTHOR:    M. Riebe  11/17/84
  178.   CHANGES:   5/15/85 MTR: Fixed input routine to allow backspaces for
  179.                           corrections.
  180.              6/20/85 RJC: Improved error correction.
  181.              5/8/90  RJC: Translated to Turbo Pascal.  Added same changes
  182.                as versions 1.1 of RDDBLN.
  183.              5/18/91 RJC: Corrected number of digits error to allow up to
  184.                6 digits.
  185. *